# Usage: rpcheck.tcl rpvariant.map

package require Iexpect

proc warn {message} {
	puts "Warning: $message"
}

proc checkDesignation {type location destination designation isReciprocal} {
	# The first test is to see if the '/' is actually part of the name, which is highly unlikely.
	if {(![info exists ::moves($destination/$designation,$type)]) || ([lsearch $::moves($destination/$designation,$type) $location] == -1)} {
		# The second test is to see if the location is part of the destination's designation list. This is the most likely case.
		if {(![info exists ::moves($destination,$designation)]) || ([lsearch $::moves($destination,$designation) $location] == -1)} {
			# The third test (split up in two) is to see if it's a reciprocal situation, as in the case of mx (the Loeb9 reduced attack move across straits). Not very common.
			if {![info exists ::moves($destination,$type)]} {
				warn "Unidirectional $::units($type) movement from $location to $destination/$designation"
			} elseif {!$isReciprocal || ([lsearch $::moves($destination,$type) "$location/$designation"] == -1)} {
				# The fourth test is simply to see if one simply forgot to specify the designation. Not a common mistake.
				if {[lsearch $::moves($destination,$type) $location] == -1} {
					warn "The $::units($type) movement between $location and $destination only to $designation in one direction"
				} else {
					warn "Unidirectional $::units($type) movement from $location to $destination/$designation"
				}
			}
		}
	}
}

array set directions {
	sc south
	wc west
	ec east
	nc north
}

array set units {
	mv army
	xc fleet
}

# Check arguments.

if {[llength $argv] < 1} {
	puts "Error: 1 argument required, the name of a RealPolitik .map file."
	puts "Usage: rpcheck.tcl rpvariant.map"
	exit
}

# Parsing the RealPolitik map file.

iexpect::Expect I -white -file [regsub -all "\\\\" [lindex $argv 0] "/"]

I expect line "^#" {
	I continue
} "^(\[^,\]+), *(\[^ \]+) (\[^ \]+)" {
	set terrain [I get match 2]
	set primary [string index $terrain 0]
	if {[string length $terrain] > 1} {
		if {[string length $terrain] > 2} {
			warn "Terrain type $terrain contains more than 2 characters in \"[I get output]\""
		}
		if {[string first [string index $terrain 1] "wv"] == -1} {
			warn "Unrecognized terrain subtype [string index $terrain 1] in \"[I get output]\""
		}
		if {[string is lower $primary] && ([string first $primary "lx"] == -1)} {
			warn "Unrecognized primary terrain type $primary in \"[I get output]\""
		}
	} elseif {[string is lower $primary] && ([string first $primary "lwxv"] == -1)} {
		warn "Unrecognized terrain type $primary in \"[I get output]\""
	}
	set location [string tolower [I get match 3]]
	set territoryName($location) [I get match 1]
	set territoryType($location) $terrain
	set alternatives($location) [I get unchecked]
	I continue
} "^-1*$" {
} "^$" {
	I continue
} default {
	warn "Unrecognized map data: \"[I get unmatched]\""
	I continue
}

I expect line "^#" {
	I continue
} "^(\[^-\]+)-(\[a-zA-Z\]{2}):" {
	set location [string tolower [I get match 1]]
	set moving [string tolower [I get match 2]]
	if {[lsearch "mv xc ec nc sc wc mx" $moving] == -1} {
		warn "Unrecognized movement $moving in \"[I get output]\""
	} else {
		eval lappend moves($location,$moving) [string tolower [I get unchecked]]
	}
	I continue
} "^-1$" {
} "^$" {
	I continue
} default {
	warn "Unrecognized map data: \"[I get unmatched]\""
	I continue
}

itcl::delete object I

# Checking the adjacencies.

foreach location [lsort [array names territoryType]] {

	# Army movement.
	if [info exists moves($location,mv)] {
		foreach destination $moves($location,mv) {
			if {[set idx [string last "/" $destination]] >= 1} {
				set designation [string range $destination [expr $idx + 1] end]
				set destination [string range $destination 0 [expr $idx - 1]]
				if {![string equal $designation "mx"]} {
					warn "Unexpected destination designation $destination/$designation in army movement for $location"
				}
				checkDesignation mv $location $destination $designation 1
			} else {
				if {(![info exists moves($destination,mv)]) || ([lsearch $moves($destination,mv) $location] == -1)} {
					warn "Unidirectional army movement from $location to $destination"
				}
			}
		}
	}

	# Army movement across straits (see Loeb9).
	if [info exists moves($location,mx)] {
		foreach destination $moves($location,mx) {
			checkDesignation mv $location $destination mx 1
		}
	}

	# Fleet movement.
	if [info exists moves($location,xc)] {
		foreach destination $moves($location,xc) {
			if {[set idx [string last "/" $destination]] >= 1} {
				set designation [string range $destination [expr $idx + 1] end]
				set destination [string range $destination 0 [expr $idx - 1]]
				if {[lsearch [array names directions] $designation] == -1} {
					warn "Unexpected destination designation $destination/$designation in fleet movement for $location"
					checkDesignation xc $location $destination $designation 1
				} else {
					checkDesignation xc $location $destination $designation 0
				}
			} else {
				if {(![info exists moves($destination,xc)]) || ([lsearch $moves($destination,xc) $location] == -1)} {
					warn "Unidirectional fleet movement from $location to $destination"
				}
			}
		}
	}

	# Fleet movement from coasts.
	foreach coast [lsort [array names directions]] {
		if [info exists moves($location,$coast)] {
			foreach destination $moves($location,$coast) {
				if {[set idx [string last "/" $destination]] >= 1} {
					set designation [string range $destination [expr $idx + 1] end]
					set destination [string range $destination 0 [expr $idx - 1]]
					if {[lsearch [array names directions] $designation] == -1} {
						warn "Unexpected destination designation $destination/$designation in fleet movement for $location/$coast"
						checkDesignation xc $location/$coast $destination $designation 1
					} else {
						checkDesignation xc $location/$coast $destination $designation 0
					}
				} else {
					if {(![info exists moves($destination,xc)]) || ([lsearch $moves($destination,xc) $location/$coast] == -1)} {
						warn "Unidirectional fleet movement from $location/$coast to $destination"
					}
				}
			}
		}
	}

}
